00100	TITLE OCCULT  -  A HIDDEN LINE ELIMINATOR  -  SEPTEMBER 1972.
00200		
00300	COMMENT /
00400	
00500	/
00600	
00700	;OCCULT IS DEPENDENT ON THE WING PRIMITIVES.
00800		EXTERN GETBLK,RELBLK
00900		EXTERN MKB,MKF,MKE,MKV,MKBFV
01000		EXTERN KLB,KLF,KLE,KLV
01100		EXTERN WING
01200		EXTERN ECW,ECCW,OTHER
01300		EXTERN BODY,FCW,FCCW,VCW,VCCW
01400		EXTERN MKEV,MKFE,ESPLIT,KLEV,KLFE
01500		EXTERN INVERT
01600	
01700	;OCCULT'S CONTEXT - FACE AND EDGE RINGS.
01800		POTNTF ←← 5	;POTENTIAL VISIBLE FACES.
01900		POTNTE ←← 1	;POTENTIAL VISIBLE EDGES.
02000		FOLDE  ←← 2	;FOLDED POTENTIAL VISIBLE EDGES.
02100		PIPE   ←← 3	;UNCOMPLETED VISIBLE OR HIDDEN EDGES.
02200		EXTERN WORLD
02300	
02400		EXTERN MAGX,MAGY,SOX,SOY
     

00100	;E.HIDE(F,E,V) - PUT POTENT EDGE TO BE HIDDEN INTO THE PIPE RING.
00200	SUBR(E.HIDE)
00300	BEGIN E.HIDE
00400		ACCUMULATORS{F,E,V,A,Q,R}
00500		LAC E,ARG2↔TEST E,POTENT↔POP3J		;MUST BE POTENT.
00600		LAC F,ARG3↔ALT A,E			;SAVE UBER-FACE.
00700		NVT V,E↔CAMN V,ARG1↔GO[
00800			NUF. F,A↔MARK A,2B17↔GO L1]
00900			PUF. F,A↔MARK A,1B17
01000	L1:	CAR Q,PIPE(A)↔CDR R,PIPE(A)		;RINGO WHEN NOT EMPTY.
01100		JUMPE R,L2↔SAD Q,E↔GO L2
01200		DAP R,PIPE(Q)↔DIP Q,PIPE(R)
01300	L2:	LAC Q,WORLD↔CDR R,PIPE(Q)		;RINGIN
01400		DAP A,PIPE(Q)↔DIP A,PIPE(R)
01500		DIP Q,PIPE(A)↔DAP R,PIPE(A)
01600		POP3J
01700	BEND
01800	
     

00100	;E.SHOW(F,E,V) - PUT POTENT EDGE TO BE SHOWN INTO THE PIPE RING.
00200	SUBR(E.SHOW)
00300	BEGIN E.SHOW
00400		ACCUMULATORS{F,E,V,A,Q,R}
00500		LAC E,ARG2↔TEST E,POTENT↔POP3J		;MUST BE POTENT.
00600		TEST E,FOLDED↔POP3J			;MUST BE FOLDED.
00700		LAC F,ARG3↔ALT A,E			;PROVIDE UNDER-FACE.
00800		NVT V,E↔SAD V,ARG1↔GO[
00900			NUF. F,A↔GO L1]
01000			PUF. F,A
01100	L1:	
01200		CDR 0,PIPE(A)↔JUMPE 0,.+3↔CAME 0,A↔POP3J ;EXIT WHEN A IS NOT EMPTY.
01300		LAC R,WORLD↔CAR Q,PIPE(R)
01400		DAP A,PIPE(Q)↔DIP A,PIPE(R)
01500		DIP Q,PIPE(A)↔DAP R,PIPE(A)
01600		POP3J
01700	BEND
     

00100	;GEOMETRIC 2D LOCII ROUTINES.
00200	
00300	;QEV(E,V).
00400	SUBR(QEV)
00500	BEGIN QEV
00600		ACCUMULATORS{E,V}
00700		LAC V,ARG1
00800		LAC E,ARG2
00900		LAC 1,CC(E)
01000		LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
01100		LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
01200		RET2
01300	BEND
01400	
01500	;QFEV(F,E,V).
01600	SUBR(QFEV)
01700	BEGIN QFEV
01800		ACCUMULATORS{E,V}
01900		LAC V,ARG1
02000		LAC E,ARG2
02100		LAC 1,CC(E)
02200		LAC BB(E)↔FMPR YPP(V)↔FADR 1,0
02300		LAC AA(E)↔FMPR XPP(V)↔FADR 1,0
02400		PFACE 0,E↔CAME 0,ARG3↔MOVNS 1
02500		RET3
02600	BEND
02700	
02800	;CROSSING(X,Y,E1,E2).
02900	SUBR(CROSSING)
03000	BEGIN CROSSING
03100		ACCUMULATORS{TT,XPTR,YPTR,E1,E2}
03200		LAC E2,ARG1
03300		LAC E1,ARG2
03400		LAC YPTR,ARG3
03500		LAC XPTR,ARG4
03600		LAC AA(E1)↔FMPR BB(E2)
03700		LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT
03800		LAC BB(E1)↔FMPR CC(E2)
03900		LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(XPTR)
04000		LAC CC(E1)↔FMPR AA(E2)
04100		LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC(YPTR)
04200		RET4
04300	BEND
     

00100	;COMPARE EDGE-EDGE.
00200		INTERN XCROSS,YCROSS,ZCROSS,EPSLON,CEECNT
00300		XCROSS: 0↔YCROSS: 0↔ZCROSS: 0
00400		XCRUX: 0↔YCRUX: 0
00500		EPSLON: 0.01↔CEECNT: 0
00600	COMMENT/
00700		-1 EDGES ARE DISJOINT.
00800		 0 EDGES E1 AND E2 ARE IDENTICAL.
00900		+Q EDGES INTERSECT IN SOME MANNER.
01000		+1 EDGES CROSS OR TOUCH EACH OTHER.
01100		441 EDGE CROSS EACH OTHER.
01200	
01300		+110 PVT(E1) IS JOINED TO PVT(E2).
01400		+120 PVT(E1) IS JOINED TO NVT(E2).
01500		+210 NVT(E1) IS JOINED TO PVT(E2).
01600		+220 NVT(E1) IS JOINED TO NVT(E2).
01700	
01800		+401 E1 crosses E2's line.
01900		+201 NVT(E1) within ε of E2's line.
02000		+101 PVT(E1) within ε of E2's line.
02100	
02200		+ 41 E2 crosses E1's line.
02300		+ 21 NVT(E2) within ε of E1's line.
02400		+ 11 PVT(E2) within ε of E1's line.
02500	/
02600	;COMPEE(E1,E2)
02700	SUBR COMPEE
02800	BEGIN COMPEE
02900		ACCUMULATORS{Q1,Q2,E1,E2,V1,V2,U1,U2,S12}
03000		AOS CEECNT
03100		SETZ 1,↔LAC E1,ARG2↔LAC E2,ARG1
03200		CAMN E1,E2↔POP2J; IDENTITY CASE.
03300	
03400	;FETCH ENDPOINTS - RING'A'AROUND TJOINTS TO GET THE JOT.
03500		PVT V1,E1↔NVT V2,E1
03600		PVT U1,E2↔NVT U2,E2
03700		TESTZ V1,1B3↔GO[TJOINT V1,V1↔GO .-2]
03800		TESTZ V2,1B3↔GO[TJOINT V2,V2↔GO .-2]
03900		TESTZ U1,1B3↔GO[TJOINT U1,U1↔GO .-2]
04000		TESTZ U2,1B3↔GO[TJOINT U2,U2↔GO .-2]
04100	
04200	;TEST FOR EDGES ALREADY HAVINGS A VERTEX OR TJOINT IN COMMON.
04300		NIM 1,110↔CAMN V1,U1↔POP2J
04400		NIM 1,120↔CAMN V1,U2↔POP2J
04500		NIM 1,210↔CAMN V2,U1↔POP2J
04600		NIM 1,220↔CAMN V2,U2↔POP2J
     

00100		LO1←←0 ↔ HI1←←1 ↔ LO2←←2 ↔ HI2←←3
00200	
00300	;TEST FOR X-SPAN NOT OVERLAPPING.
00400		LAC LO1,XPP(V1)↔LAC HI1,XPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
00500		LAC LO2,XPP(U1)↔LAC HI2,XPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
00600		CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
00700		CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO L0
00800	
00900	;TEST FOR Y-SPAN NOT OVERLAPPING.
01000		LAC LO1,YPP(V1)↔LAC HI1,YPP(V2)↔CAMG HI1,LO1↔EXCH HI1,LO1
01100		LAC LO2,YPP(U1)↔LAC HI2,YPP(U2)↔CAMG HI2,LO2↔EXCH HI2,LO2
01200		CAMG LO1,HI2↔GO .+4↔FSBR LO1,HI2↔CAMLE LO1,EPSLON↔GO L0
01300		CAMG LO2,HI1↔GO .+4↔FSBR LO2,HI1↔CAMLE LO2,EPSLON↔GO[L0:
01400		SETO 1,↔POP2J]
01500	
01600		SETZ 1,
     

00100	;COMPARE E1 AND U1.
00200		LAC Q1,CC(E1)
00300		LAC BB(E1)↔FMPR YPP(U1)↔FADR Q1,0
00400		LAC AA(E1)↔FMPR XPP(U1)↔FADR Q1,0
00500		LACM Q1↔CAMG EPSLON↔TRO 1,10; U1 TOUCHES E1'S LINE.
00600	
00700	;COMPARE E1 AND U2.
00800		LAC Q2,CC(E1)
00900		LAC BB(E1)↔FMPR YPP(U2)↔FADR Q2,0
01000		LAC AA(E1)↔FMPR XPP(U2)↔FADR Q2,0
01100		LACM Q2↔CAMG EPSLON↔TRO 1,20; U2 TOUCHES E1'S LINE.
01200	
01300	;EXIT WHEN U1 AND U2 ARE CLEAR OF E1 ON THE SAME SIDE.
01400		XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,30↔GO .+2↔SETO 1,↔POP2J]
01500		TRO 1,40   ;E1 CROSSES E2'S LINE.
01600	
01700	;COMPARE E2 AND V1.
01800		LAC Q1,CC(E2)
01900		LAC BB(E2)↔FMPR YPP(V1)↔FADR Q1,0
02000		LAC AA(E2)↔FMPR XPP(V1)↔FADR Q1,0
02100		LACM Q1↔CAMG EPSLON↔TRO 1,100; V1 TOUCHES E2'S LINE.
02200	
02300	;COMPARE E2 AND V2.
02400		LAC Q2,CC(E2)
02500		LAC BB(E2)↔FMPR YPP(V2)↔FADR Q2,0
02600		LAC AA(E2)↔FMPR XPP(V2)↔FADR Q2,0
02700		LACM Q2↔CAMG EPSLON↔TRO 1,200; V2 TOUCHES E2'S LINE.
02800	
02900	;EXIT WHEN V1 AND V2 ARE CLEAR OF E2 ON THE SAME SIDE.
03000		XOR Q1,Q2↔JUMPGE Q1,[TRNE 1,300↔GO .+2↔SETO 1,↔POP2J]
03100		TRO 1,400   ;E2 CROSSES E1'S LINE.
03200	
03300	;SOLVE FOR CROSSING LOCUS.
03400		DAC 1,AC1
03500		LAC AA(E1)↔FMPR BB(E2)
03600		LAC 1,AA(E2)↔FMPR 1,BB(E1)↔FSBR 0,1↔DAC TT#
03700		LAC BB(E1)↔FMPR CC(E2)
03800		LAC 1,BB(E2)↔FMPR 1,CC(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC XCROSS
03900		LAC CC(E1)↔FMPR AA(E2)
04000		LAC 1,CC(E2)↔FMPR 1,AA(E1)↔FSBR 0,1↔FDVR 0,TT↔DAC YCROSS
04100		LAC XCROSS↔FMPR MAGX↔FADR SOX↔DAC XCRUX
04200		LAC YCROSS↔FMPR MAGY↔FADR SOY↔DAC YCRUX
04300		LAC 1,AC1↔TRO 1,1↔POP2J
04400	BEND
     

00100	;ZEDGE(E) - SOLVE FOR ZDEPTHS AT THE CROSSING(XCROSS,YCROSS).
00200	;Z←((Z2-Z1)*(XCROSS-X1)/(X2-X1))+Z1
00300	SUBR(ZDEDGE)
00400	BEGIN ZDEDGE
00500		ACCUMULATORS{E,V1,V2}
00600		
00700		LAC E,ARG1
00800		PVT V1,E↔NVT V2,E
00900		LACM 0,AA(E)↔LACM 1,BB(E)↔CAMGE 1,0↔GO L
01000	
01100	;WHEN DX ≥ DY:
01200		LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
01300		LAC 0,XCROSS↔ FSBR 0,XPP(V1)↔FMPR 1,0
01400		LAC 0,XPP(V2)↔FSBR 0,XPP(V1)↔FDVR 1,0
01500		FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
01600	
01700	;WHEN DY > DX:
01800	L:	LAC 1,ZPP(V2)↔FSBR 1,ZPP(V1)
01900		LAC 0,YCROSS↔ FSBR 0,YPP(V1)↔FMPR 1,0
02000		LAC 0,YPP(V2)↔FSBR 0,YPP(V1)↔FDVR 1,0
02100		FADR 1,ZPP(V1)↔DAC 1,ZCROSS↔POP1J
02200	BEND
     

00100	;VNEW ← EBREAK(EDGE) - VERY MUCH LIKE ESPLIT, BUT WITH MORE FRILLS.
00200	SUBR(EBREAK)
00300	BEGIN EBREAK
00400		ACCUMULATORS{A,B,E,V,Q,R,ENEW,VNEW,S12,ANEW,PV,NV}
00500	;GET ZDEPTH AT CROSSING.
00600		CALL ZDEDGE,ARG1
00700	;CREATE A NEW EDGE AND A NEW VERTEX.
00800		CDR E,ARG1↔PVT V,E↔PBODY B,E
00900		SETQ(VNEW,{MKV,B})↔MARK VNEW,(TEMPORARY∨POTENT)
01000		TJOIN. VNEW,VNEW
01100		LAC XCROSS↔DAC XPP(VNEW)↔LAC XCRUX↔XDC. 0,VNEW
01200		LAC YCROSS↔DAC YPP(VNEW)↔LAC YCRUX↔YDC. 0,VNEW
01300		LAC ZCROSS↔DAC ZPP(VNEW)
01400		SETQ(ENEW,{MKE,B})↔MARK ENEW,POTENT
01500	;COPY EDGE COEFFICIENTS.
01600		SLIMZ AA(E)↔LIM AA(ENEW)↔BLT CC(ENEW)
01700	;MAKE AN ALT BLOCK FOR ENEW.
01800		MOVEI 1,=10↔CALL GETBLK,1↔ADDI 1,3↔LAC ANEW,1
01900		ALT. ANEW,ENEW↔ALT. ENEW,ANEW
02000		ALT A,E↔LAC -1(A)↔DAC -1(ANEW)↔DAP PUFACE#
02100	;POTNTE RING IN.
02200		CDR R,WORLD↔CAR Q,POTNTE(R)
02300		DAP ANEW,POTNTE(Q)↔DIP ANEW,POTNTE(R)
02400		DIP Q,POTNTE(ANEW)↔DAP R,POTNTE(ANEW)
02500	;FOLDE RINGIN.
02600		TESTZ E,FOLDED↔GO[MARK ENEW,FOLDED↔CAR Q,FOLDE(A)
02700			DAP ANEW,FOLDE(Q)↔DIP ANEW,FOLDE(A)
02800			DIP Q,FOLDE(ANEW)↔DAP A,FOLDE(ANEW)↔GO .+1]
02900	;UPDATE V'S FIRST PTR WHEN NECESSARY.
03000		PED 0,V↔CAMN 0,E↔PED. ENEW,V
03100	;PLACE VNEW BETWEEN E AND ENEW.
03200		PED. ENEW,VNEW↔PVT PV,E↔PVT. PV,ENEW
03300		PVT. VNEW,E↔NVT. VNEW,ENEW
03400		PFACE 0,E↔PFACE. 0,ENEW
03500		NFACE 0,E↔NFACE. 0,ENEW
03600	;NEW UPPER WINGS ARE LIKE THE OLDE;
03700		PCW 0,E↔CALL WING,0,ENEW
03800		NCCW 0,E↔CALL WING,0,ENEW
03900	;EDGES POINT AT EACH OTHER ACROSS VNEW.
04000		NCCW.. ENEW,E↔PCW..  ENEW,E
04100		NCW..  E,ENEW↔PCCW.. E,ENEW
     

00100	;WHEN NV IS POTENT AND PV ISN'T, RINGO E FROM THE PIPE.
00200		NVT NV,E↔TEST NV,POTENT↔GO L1↔TESTZ PV,POTENT↔GO L1
00300		CAR Q,PIPE(A)↔CDR R,PIPE(A)
00400		DAP R,PIPE(Q)↔DIP Q,PIPE(R)
00500		MARKZ A,1B17 ;PVHID.
00600	
00700	;WHEN PV IS HIDDEN OR VISIBLE THEN RING ENEW INTO THE PIPE.
00800	L1:	TESTZ PV,POTENT↔GO L2
00900		TESTZ PV,VISIBLE
01000		GO[CALL E.SHOW,PUFACE,ENEW,PV↔GO .+1]
01100	
01200	L2:	LAC 1,VNEW↔POP1J
01300	
01400	BEND
     

00100	;JFUSE(J1,J2) - JOINT FUSION.
00200	SUBR(JFUSE)
00300	BEGIN JFUSE
00400		ACCUMULATORS{J1,J2,NJ1,NJ2,JTOP,JBOT}
00500	
00600		CDR J1,ARG2↔CDR J2,ARG1
00700	
00800	;GET THE LAST-JUT → JOT.
00900		TESTZ J1,1B3↔TJOINT J1,J1
01000		LAC NJ1,J1
01100		TESTZ J1,1B3↔GO[LAC NJ1,J1↔TJOINT J1,J1↔GO .-2]
01200	
01300		TESTZ J2,1B3↔TJOINT J2,J2
01400		LAC NJ2,J2
01500		TESTZ J2,1B3↔GO[LAC NJ2,J2↔TJOINT J2,J2↔GO .-2]
01600	
01700	;GET TOP JOT INTO J1 & JTOP.
01800		LAC ZPP(J1)↔CAML ZPP(J2)
01900		GO .+3↔EXCH J1,J2↔EXCH NJ1,NJ2
02000		DAC J1,JTOP
02100	;GET BOTTOM JUT INTO JBOT.
02200		LAC JBOT,NJ1
02300		LAC  ZPP(NJ1)
02400		CAML ZPP(NJ2)↔LAC JBOT,NJ2
02500	
02600	;SET THE TJOINT BITS.
02700		MARK  J1,1B4;JOT
02800		MARKZ J2,1B4
02900		MARK  J2,1B3;JUT
03000	;MERGE J1'S AND J2'S TJOINT RINGS IN ORDER BY ZPP;
03100	;ZPP HIGH IS VISIBLE AND NEAR - ZPP LOW IS HIDDEN AND FAR.
03200		TJOIN. JTOP,JBOT
03300		CAMN J1,NJ1↔GO[TJOIN. JBOT,JTOP↔POP2J]
03400	L0:	LAC 0,ZPP(J2)	;RING-2'S DEPTH.
03500		LAC NJ1,J1	;NEAREST JOINT UN-MERGED.
03600	L1:	TJOINT J1,J1	;NEXT JOINT OUT ON RING-1.
03700		CAMN J1,JTOP	;TEST FOR END OF RING.
03800		POP2J
03900		CAMGE ZPP(J1)	;SKIP J2 NEARER THAN J1.
04000		GO L1		;RING-1 IS STILL THE NEAREST.
04100		TJOIN. J2,NJ1	;NEAREST JOINT NOW POINTS AT OTHER RING.
04200		EXCH J1,J2	;SWAP THE RINGS.
04300		GO L0
04400	BEND
     

00100	;MAKE TJOINT (FOLD,EDGE,Q) OF MOST RECENT COMPEE.
00200	;SUBR(MKTJ)
00300	;BEGIN MKTJ
     

00100	;ZDEPTH(F,V)
00200	SUBR(ZDEPTH)
00300	BEGIN ZDEPTH
00400		ACCUMULATORS{F,V}
00500		LAC V,ARG1
00600		LAC F,ARG2
00700		LAC 1,KK(F)
00800		LAC AA(F)↔FMPR XPP(V)↔FSBR 1,0
00900		LAC BB(F)↔FMPR YPP(V)↔FSBR 1,0
01000		FDVR 1,CC(F)
01100		RET2
01200	BEND
01300	
01400	;ZDALT(F,X,Y)
01500	SUBR(ZDALT)
01600	BEGIN ZDALT
01700		ACCUMULATORS{F}
01800		LAC F,ARG3
01900		LAC 1,KK(F)
02000		LAC AA(F)↔FMPR ARG2↔FSBR 1,0
02100		LAC BB(F)↔FMPR ARG1↔FSBR 1,0
02200		FDVR 1,CC(F)
02300		RET3
02400	BEND
02500	
02600	;UFACE(E,V)
02700	SUBR(UFACE)
02800	BEGIN UFACE
02900		ACCUMULATORS{E,V,XE}
03000		LAC E,ARG2↔ALT XE,E
03100		NVT V,E↔CAMN V,ARG1↔GO[NUF 1,XE↔RET2]
03200		PVT V,E↔CAMN V,ARG1↔GO[PUF 1,XE↔RET2]
03300		FATAL(UFACE)
03400		LIT
03500	BEND
03600	
03700	;UFACE.(Q,E,V)
03800	SUBR(UFACE.)
03900	BEGIN UFACE.
04000		ACCUMULATORS{Q,E,V,XE}
04100		CDR E,ARG2↔ALT XE,E
04200		CDR Q,ARG3
04300		NVT V,E↔CAMN V,ARG1↔GO[NUF. Q,XE↔RET3]
04400		PVT V,E↔CAMN V,ARG1↔GO[PUF. Q,XE↔RET3]
04500		FATAL(UFACE.)
04600		LIT
04700	BEND
     

00100	SUBR(POTEN.)
00200		LAC 1,ARG1↔MARKZ 1,VISIBLE↔MARK 1,POTENT↔RET1
00300	SUBR(HIDE.)
00400		LAC 1,ARG1↔MARKZ 1,POTENT∨VISIBLE↔RET1
00500	SUBR(VISIB.)
00600		LAC 1,ARG1↔MARK 1,VISIBLE↔MARKZ 1,POTENT↔RET1
00700	SUBR(FOLD.)
00800		LAC 1,ARG1↔MARK  1,FOLDED ↔RET1
00900	SUBR(TJUT.)
01000		LAC 1,ARG1↔MARK  1,1B3↔RET1
01100	SUBR(TJOT.)
01200		LAC 1,ARG1↔MARK  1,1B4↔RET1
01300	SUBR(TJUT)
01400		LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(1B3)↔RET1
01500	SUBR(TJOT)
01600		LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(1B4)↔RET1
01700	SUBR(TJ)
01800		LAC 1,ARG1↔CAR 1,(1)↔ANDI 1,(3B4)↔RET1
01900	SUBR(PVHID)
02000		LAC 1,ARG1↔ALT 1,1↔CAR 1,(1)↔ANDI 1,1↔RET1
02100	SUBR(NVHID)
02200		LAC 1,ARG1↔ALT 1,1↔CAR 1,(1)↔ANDI 1,2↔RET1
02300	SUBR(PVHID.)
02400		LAC 1,ARG1↔ALT 1,1↔CAR(1)↔IORI 1↔DIP(1)↔RET1
02500	SUBR(NVHID.)
02600		LAC 1,ARG1↔ALT 1,1↔CAR(1)↔IORI 2↔DIP(1)↔RET1
02700	SUBR(PVHIDZ)
02800		LAC 1,ARG1↔ALT 1,1↔CAR(1)↔ANDI 2↔DIP(1)↔RET1
02900	SUBR(NVHIDZ)
03000		LAC 1,ARG1↔ALT 1,1↔CAR(1)↔ANDI 1↔DIP(1)↔RET1
03100	
03200	END